# loading in SLICER packages
library("devtools")
Loading required package: usethis
install_github("jw156605/SLICER")
Skipping install of 'SLICER' from a github remote, the SHA1 (cb1be8ac) has not changed since last install.
  Use `force = TRUE` to force installation
library(SLICER)
library(lle)
Loading required package: scatterplot3d
Loading required package: MASS
Loading required package: snowfall
Loading required package: snow
# finding the number of initial clusters for reconstructing the trajectory
k = select_k(top_genes, kmin = 3)
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
Warning in areaahull(alpha_hull) :
  Problem in area computation (Returns NA)
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
# performing LLE a form of dimensionality reduction on the gene expression data
# m = 3 bc that is the number of dimensions used in the figures in the paper 
traj_lle = lle(top_genes, m=3, k)$Y
finding neighbours
calculating weights
computing coordinates
# build a knearest neighbor graph to find the distances betwen cells
traj_graph = conn_knn_graph(traj_lle, k)

distances_inactive = process_distance(traj_graph, 402) / 5.044693
distances_active = process_distance(traj_graph, 346) / 9.541308
scatterplot3d(traj_lle[,1],traj_lle[,3],traj_lle[,2], grid = FALSE)
library(rgl)
library(plotly)
Loading required package: ggplot2

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:MASS’:

    select

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout
plot3d(traj_lle[,1],traj_lle[,3],traj_lle[,2],type = "s", size = 1, lit = TRUE) 
lle_df = data.frame(traj_lle )
lle_df$pseudotime = as.double(t(distances_inactive))
lle_df$active = "CCI"
lle_df[active_cell_numbers,4] = as.double(t(distances_active))[active_cell_numbers]
lle_df[active_cell_numbers,5] = "CCA"
lle_df$active = as.factor(lle_df$active)
lle_df$ident = identified_cells$GroupID_Fig1a

axx <- list(
  title = "LLE 1"
)

axy <- list(
  title = "LLE 2"
)

axz <- list(
  title = "LLE 3"
)

fig <- plot_ly(lle_df, x = ~X1, y = ~X2, z = ~X3, marker = list(size = 6), symbol = ~active, symbols = c("diamond", "circle") )
fig <- fig %>% add_markers(color = ~pseudotime, colors = c('black', 'red', 'orange', 'yellow'))
fig <- fig %>% layout(scene = list(aspectmode = "cube", xaxis=axx,yaxis=axy,zaxis=axz))

fig
fig <- plot_ly(lle_df, x = ~X1, y = ~X2, z = ~X3, color = ~ident)
fig <- fig %>% add_markers()
fig <- fig %>% layout(scene = list(aspectmode = "cube"))
fig
active_cells
top_genes_test = as.data.frame(top_genes)
top_genes_test$row_number = 1:nrow(top_genes_test)
active_cell_numbers = top_genes_test[active_cells,401]
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CiMgbG9hZGluZyBpbiBTTElDRVIgcGFja2FnZXMKbGlicmFyeSgiZGV2dG9vbHMiKQppbnN0YWxsX2dpdGh1YigiancxNTY2MDUvU0xJQ0VSIikKbGlicmFyeShTTElDRVIpCmxpYnJhcnkobGxlKQpgYGAKCgpgYGB7cn0KIyBmaW5kaW5nIHRoZSBudW1iZXIgb2YgaW5pdGlhbCBjbHVzdGVycyBmb3IgcmVjb25zdHJ1Y3RpbmcgdGhlIHRyYWplY3RvcnkKayA9IHNlbGVjdF9rKHRvcF9nZW5lcywga21pbiA9IDMpCmBgYApgYGB7cn0KIyBwZXJmb3JtaW5nIExMRSBhIGZvcm0gb2YgZGltZW5zaW9uYWxpdHkgcmVkdWN0aW9uIG9uIHRoZSBnZW5lIGV4cHJlc3Npb24gZGF0YQojIG0gPSAzIGJjIHRoYXQgaXMgdGhlIG51bWJlciBvZiBkaW1lbnNpb25zIHVzZWQgaW4gdGhlIGZpZ3VyZXMgaW4gdGhlIHBhcGVyIAp0cmFqX2xsZSA9IGxsZSh0b3BfZ2VuZXMsIG09MywgaykkWQpgYGAKCgpgYGB7cn0KIyBidWlsZCBhIGtuZWFyZXN0IG5laWdoYm9yIGdyYXBoIHRvIGZpbmQgdGhlIGRpc3RhbmNlcyBiZXR3ZW4gY2VsbHMKdHJhal9ncmFwaCA9IGNvbm5fa25uX2dyYXBoKHRyYWpfbGxlLCBrKQpgYGAKYGBge3J9CiMgY29uc3RydWN0aW5nIHRoZSBjZWxsIG9yZGVyIGFuZCBmaW5kaW5nIGJyYW5jaGVzIGluIHRoZSB0cmFqZWN0b3J5IAplbmRzID0gZmluZF9leHRyZW1lX2NlbGxzKHRyYWpfZ3JhcGgsIHRyYWpfbGxlKQpzdGFydCA9IDQwMiAjIG5lZWRzIHRvIGJlIGNoYW5nZWQgdG8gYSBrbm93biBjYXJkaWFjIGZpYnJvYmxhc3QgCmNlbGxzX29yZGVyZWQgPSBjZWxsX29yZGVyKHRyYWpfZ3JhcGgsIHN0YXJ0KQpncmFwaF9wcm9jZXNzX2Rpc3RhbmNlKHRyYWpfZ3JhcGgsdHJhal9sbGUsc3RhcnQpCmJyYW5jaGVzID0gYXNzaWduX2JyYW5jaGVzKHRyYWpfZ3JhcGgsMjAsIG1pbl9icmFuY2hfbGVuID0gMTApCmBgYAoKCmBgYHtyfQpkaXN0YW5jZXNfaW5hY3RpdmUgPSBwcm9jZXNzX2Rpc3RhbmNlKHRyYWpfZ3JhcGgsIDQwMikgLyA1LjA0NDY5MwpkaXN0YW5jZXNfYWN0aXZlID0gcHJvY2Vzc19kaXN0YW5jZSh0cmFqX2dyYXBoLCAzNDYpIC8gOS41NDEzMDgKCmBgYApgYGB7cn0Kc2NhdHRlcnBsb3QzZCh0cmFqX2xsZVssMV0sdHJhal9sbGVbLDNdLHRyYWpfbGxlWywyXSwgZ3JpZCA9IEZBTFNFKQpgYGAKCmBgYHtyfQpsaWJyYXJ5KHJnbCkKbGlicmFyeShwbG90bHkpCmBgYAoKYGBge3J9CnBsb3QzZCh0cmFqX2xsZVssMV0sdHJhal9sbGVbLDNdLHRyYWpfbGxlWywyXSx0eXBlID0gInMiLCBzaXplID0gMSwgbGl0ID0gVFJVRSkgCmBgYAoKCmBgYHtyfQpsbGVfZGYgPSBkYXRhLmZyYW1lKHRyYWpfbGxlICkKbGxlX2RmJHBzZXVkb3RpbWUgPSBhcy5kb3VibGUodChkaXN0YW5jZXNfaW5hY3RpdmUpKQpsbGVfZGYkYWN0aXZlID0gIkNDSSIKbGxlX2RmW2FjdGl2ZV9jZWxsX251bWJlcnMsNF0gPSBhcy5kb3VibGUodChkaXN0YW5jZXNfYWN0aXZlKSlbYWN0aXZlX2NlbGxfbnVtYmVyc10KbGxlX2RmW2FjdGl2ZV9jZWxsX251bWJlcnMsNV0gPSAiQ0NBIgpsbGVfZGYkYWN0aXZlID0gYXMuZmFjdG9yKGxsZV9kZiRhY3RpdmUpCmxsZV9kZiRpZGVudCA9IGlkZW50aWZpZWRfY2VsbHMkR3JvdXBJRF9GaWcxYQpgYGAKCgpgYGB7cn0KCmF4eCA8LSBsaXN0KAogIHRpdGxlID0gIkxMRSAxIgopCgpheHkgPC0gbGlzdCgKICB0aXRsZSA9ICJMTEUgMiIKKQoKYXh6IDwtIGxpc3QoCiAgdGl0bGUgPSAiTExFIDMiCikKCmZpZyA8LSBwbG90X2x5KGxsZV9kZiwgeCA9IH5YMSwgeSA9IH5YMiwgeiA9IH5YMywgbWFya2VyID0gbGlzdChzaXplID0gNiksIHN5bWJvbCA9IH5hY3RpdmUsIHN5bWJvbHMgPSBjKCJkaWFtb25kIiwgImNpcmNsZSIpICkKZmlnIDwtIGZpZyAlPiUgYWRkX21hcmtlcnMoY29sb3IgPSB+cHNldWRvdGltZSwgY29sb3JzID0gYygnYmxhY2snLCAncmVkJywgJ29yYW5nZScsICd5ZWxsb3cnKSkKZmlnIDwtIGZpZyAlPiUgbGF5b3V0KHNjZW5lID0gbGlzdChhc3BlY3Rtb2RlID0gImN1YmUiLCB4YXhpcz1heHgseWF4aXM9YXh5LHpheGlzPWF4eikpCgpmaWcKYGBgCmBgYHtyfQogaW5hY3RpdmVfY2VsbF9yb3dzID0gISgxOm5yb3cobGxlX2RmKSAgJWluJSBhY3RpdmVfY2VsbF9udW1iZXJzICkKbGxlX2RmW2luYWN0aXZlX2NlbGxfcm93cyxdCmBgYAoKCgpgYGB7cn0KZmlnIDwtIHBsb3RfbHkobGxlX2RmLCB4ID0gflgxLCB5ID0gflgyLCB6ID0gflgzLCBjb2xvciA9IH5pZGVudCkKZmlnIDwtIGZpZyAlPiUgYWRkX21hcmtlcnMoKQpmaWcgPC0gZmlnICU+JSBsYXlvdXQoc2NlbmUgPSBsaXN0KGFzcGVjdG1vZGUgPSAiY3ViZSIpKQpmaWcKYGBgCmBgYHtyfQphY3RpdmVfY2VsbHMKdG9wX2dlbmVzX3Rlc3QgPSBhcy5kYXRhLmZyYW1lKHRvcF9nZW5lcykKdG9wX2dlbmVzX3Rlc3Qkcm93X251bWJlciA9IDE6bnJvdyh0b3BfZ2VuZXNfdGVzdCkKYWN0aXZlX2NlbGxfbnVtYmVycyA9IHRvcF9nZW5lc190ZXN0W2FjdGl2ZV9jZWxscyw0MDFdCmBgYAoKCgoK